home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol146 / xlprin.c < prev    next >
Encoding:
C/C++ Source or Header  |  1986-12-16  |  3.4 KB  |  173 lines
  1. /* xlprint - xlisp print routine */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. #ifdef MEGAMAX
  9. overlay "io"
  10. #endif
  11.  
  12. /* external variables */
  13. extern NODE *xlstack;
  14. extern char buf[];
  15.  
  16. /* xlprint - print an xlisp value */
  17. xlprint(fptr,vptr,flag)
  18.   NODE *fptr,*vptr; int flag;
  19. {
  20.     NODE *nptr,*next;
  21.  
  22.     /* print nil */
  23.     if (vptr == NIL) {
  24.     xlputstr(fptr,"NIL");
  25.     return;
  26.     }
  27.  
  28.     /* check value type */
  29.     switch (ntype(vptr)) {
  30.     case SUBR:
  31.         putatm(fptr,"Subr",vptr);
  32.         break;
  33.     case FSUBR:
  34.         putatm(fptr,"FSubr",vptr);
  35.         break;
  36.     case LIST:
  37.         xlputc(fptr,'(');
  38.         for (nptr = vptr; nptr != NIL; nptr = next) {
  39.             xlprint(fptr,car(nptr),flag);
  40.         if (next = cdr(nptr))
  41.             if (consp(next))
  42.             xlputc(fptr,' ');
  43.             else {
  44.             xlputstr(fptr," . ");
  45.             xlprint(fptr,next,flag);
  46.             break;
  47.             }
  48.         }
  49.         xlputc(fptr,')');
  50.         break;
  51.     case SYM:
  52.         xlputstr(fptr,xlsymname(vptr));
  53.         break;
  54.     case INT:
  55.         putdec(fptr,vptr->n_int);
  56.         break;
  57.     case FLOAT:
  58.         putfloat(fptr,vptr->n_float);
  59.         break;
  60.     case STR:
  61.         if (flag)
  62.         putstring(fptr,vptr->n_str);
  63.         else
  64.         xlputstr(fptr,vptr->n_str);
  65.         break;
  66.     case FPTR:
  67.         putatm(fptr,"File",vptr);
  68.         break;
  69.     case OBJ:
  70.         putatm(fptr,"Object",vptr);
  71.         break;
  72.     case FREE:
  73.         putatm(fptr,"Free",vptr);
  74.         break;
  75.     default:
  76.         putatm(fptr,"Foo",vptr);
  77.         break;
  78.     }
  79. }
  80.  
  81. /* xlterpri - terminate the current print line */
  82. xlterpri(fptr)
  83.   NODE *fptr;
  84. {
  85.     xlputc(fptr,'\n');
  86. }
  87.  
  88. /* xlputstr - output a string */
  89. xlputstr(fptr,str)
  90.   NODE *fptr; char *str;
  91. {
  92.     while (*str)
  93.     xlputc(fptr,*str++);
  94. }
  95.  
  96. /* putstring - output a string */
  97. LOCAL putstring(fptr,str)
  98.   NODE *fptr; char *str;
  99. {
  100.     int ch;
  101.  
  102.     /* output the initial quote */
  103.     xlputc(fptr,'"');
  104.  
  105.     /* output each character in the string */
  106.     while (ch = *str++)
  107.  
  108.     /* check for a control character */
  109.     if (ch < 040 || ch == '\\') {
  110.         xlputc(fptr,'\\');
  111.         switch (ch) {
  112.         case '\033':
  113.             xlputc(fptr,'e');
  114.             break;
  115.         case '\n':
  116.             xlputc(fptr,'n');
  117.             break;
  118.         case '\r':
  119.             xlputc(fptr,'r');
  120.             break;
  121.         case '\t':
  122.             xlputc(fptr,'t');
  123.             break;
  124.         case '\\':
  125.             xlputc(fptr,'\\');
  126.             break;
  127.         default:
  128.             putoct(fptr,ch);
  129.             break;
  130.         }
  131.     }
  132.  
  133.     /* output a normal character */
  134.     else
  135.         xlputc(fptr,ch);
  136.  
  137.     /* output the terminating quote */
  138.     xlputc(fptr,'"');
  139. }
  140.  
  141. /* putatm - output an atom */
  142. LOCAL putatm(fptr,tag,val)
  143.   NODE *fptr; char *tag; NODE *val;
  144. {
  145.     sprintf(buf,"#<%s: #",tag); xlputstr(fptr,buf);
  146.     sprintf(buf,AFMT,val); xlputstr(fptr,buf);
  147.     xlputc(fptr,'>');
  148. }
  149.  
  150. /* putdec - output a decimal number */
  151. LOCAL putdec(fptr,n)
  152.   NODE *fptr; FIXNUM n;
  153. {
  154.     sprintf(buf,IFMT,n);
  155.     xlputstr(fptr,buf);
  156. }
  157.  
  158. /* putfloat - output a floating point number */
  159. LOCAL putfloat(fptr,n)
  160.   NODE *fptr; FLONUM n;
  161. {
  162.     sprintf(buf,FFMT,n);
  163.     xlputstr(fptr,buf);
  164. }
  165.  
  166. /* putoct - output an octal byte value */
  167. LOCAL putoct(fptr,n)
  168.   NODE *fptr; int n;
  169. {
  170.     sprintf(buf,"%03o",n);
  171.     xlputstr(fptr,buf);
  172. }
  173.